PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/basic/qbware.exe/LOOK.BAS

BASIC Source File | 1990-11-30 | 4.9 KB | 175 lines

DECLARE SUB SetDirectory (Dir$)
DECLARE SUB FindFile (Root.Dir$, Target.File$, Total.Files%, Tot.Fsize#)
DECLARE SUB GetDirectory (Dir$)
DECLARE SUB FlFind (FlSpec$, BYVAL addr%)
'*****************************************************************************

'Copyright (c) 1987,1988 Marcel Madonna

'LOOK.BAS shows the use of some of the DOS file management services and
'  recursive subroutine usage.
'This program will scan all directories in a disk, looking for a file.
'
' ********************* N O T E *************************
'
'This program cannot be used from the DOS prompt without Microsoft
'QuickBasic V4.0 and a registered copy of QBWARE.
'
'To compile it, at the DOS prompt type:

'               bc look;
'               link /ex /noe look,,,brun40 qbware;
'               del look.obj
'               del look.map

'To run it fromthe QuickBasic development environment, type:
'
'               qb look /l qbware
'               [Shift] + F5

'To execute LOOK just type "LOOK" followed by a file specification at the
'DOS prompt

'For Example:

'       LOOK *.Bak

'will find all files on the current drive with an extension of BAK

'*****************************************************************************

    OPTION BASE 1
    CLEAR , , 5000                  'Need a large stack
    CLS
    PRINT "Look - Version 1.0  (C) Copyright 1987,1988 AJM Software"
    Target.File$ = COMMAND$
    IF Target.File$ = "" THEN
        INPUT "Enter a Filename:", Target.File$
    END IF

    Dir$ = SPACE$(64)               'Initialize for ALC routine
    CALL GetDirectory(Dir$)         'Save current directory
    Root.Dir$ = "\"                 'Start with the root directory

    CALL FindFile(Root.Dir$, Target.File$, Tot.Files%, Tot.Fsize#)

    CALL SetDirectory(Dir$)         'Restore directory



    PRINT "Total Files";
    PRINT TAB(13); Tot.Files%;
    PRINT TAB(40); "Total Bytes";
    PRINT TAB(55); Tot.Fsize#
    END

    SUB FindFile (Target.Dir$, Target.File$, Tot.Files%, Tot.Fsize#)

    CALL SetDirectory(Target.Dir$)          'Change to new directory

    PRINT "...Searching " + Target.Dir$
    GOTO A1000.Start.Search                 'Skip Array init routine

A0500.Dim.Array:        'Leave this here so we can reference the array

    REDIM DirList$(Count%)                  'Dimension the array fo FLFIND
    FOR x% = LBOUND(DirList$) TO Count%     'Initialize each element of array
        DirList$(x%) = SPACE$(40)       'to 40 blanks
    NEXT
    RETURN

A1000.Start.Search:

    FlSpec$ = Target.File$ + CHR$(0)        'Make it an ASCIIZ string

    CALL Flcnt(FlSpec$, Count%)             'Get a count of matching files

    IF Count% <> 0 THEN                     'Did we get any hits?
        GOSUB A0500.Dim.Array
        CALL FlFind(FlSpec$, VARPTR(DirList$(LBOUND(DirList$))))
    ELSE
        GOTO A2000.NextDir              '...No - search for sub-directories
    END IF

'   Each element of the array will be broken down into components
'   The layout of each item is:

'       Pos.    Description

'       1-5     File Attributes
'       6-13    File creation time (HH:MM:SS)
'       14-23   File creation date (MM-DD-YYYY)
'       24-25   Low order file size
'       26-27   High order file size
'       28-39   File name

    FOR x% = LBOUND(DirList$) TO Count%

        XFname$ = MID$(DirList$(x%), 28, 12)
        Fattr$ = MID$(DirList$(x%), 1, 5)
        ftime$ = MID$(DirList$(x%), 6, 8)
        fdate$ = MID$(DirList$(x%), 14, 10)
        Fsize1# = CVI(MID$(DirList$(x%), 26, 2)) * 65536
        Fsize2# = CVI(MID$(DirList$(x%), 24, 2))
        IF Fsize2# < 0 THEN
            Fsize2# = 65536 + Fsize2#
        END IF
        Fsize# = Fsize1# + Fsize2#
        PRINT TAB(6); XFname$;
        PRINT TAB(22); Fattr$;
        PRINT TAB(28); fdate$;
        PRINT TAB(40); ftime$;
        PRINT TAB(50); Fsize#
        Tot.Files% = Tot.Files% + 1
        Tot.Fsize# = Tot.Fsize# + Fsize#
    NEXT

A2000.NextDir:

    FlSpec$ = "*.*" + CHR$(0)               'Get all files in this directory

    CALL Flcnt(FlSpec$, Count%)             'Get a count

    IF Count% <> 0 THEN                     'Any files this directory?
        GOSUB A0500.Dim.Array
        CALL FlFind(FlSpec$, VARPTR(DirList$(LBOUND(DirList$))))
    ELSE
        EXIT SUB                        '...No - just exit
    END IF

    FOR x% = LBOUND(DirList$) TO Count%
        Fattr$ = MID$(DirList$(x%), 1, 5)
        XFname$ = MID$(DirList$(x%), 28, 12)
        IF INSTR(Fattr$, "D") <> 0 AND LEFT$(XFname$, 1) <> "." THEN
            IF Target.Dir$ = "\" THEN
                NextDir$ = "\" + XFname$
            ELSE
                NextDir$ = Target.Dir$ + "\" + XFname$
            END IF
            CALL FindFile(NextDir$, Target.File$, Tot.Files%, Tot.Fsize#)
        END IF
    NEXT

    EXIT SUB

    END SUB

    SUB GetDirectory (Dir$) STATIC
    CALL FlGDir(Dir$)                'Get current directory
    Dir$ = "\" + Dir$                'Make it DOS format
    END SUB

    SUB SetDirectory (Dir$) STATIC

    Current.Dir$ = Dir$ + CHR$(0)
    CALL FlCDir(Current.Dir$, Rc%)          'Change current directory to root
    IF Rc% <> 0 THEN
        CLS
        PRINT "Cannot change to directory " + Dir$
        PRINT "Error code", Rc%
        END
    END IF

    END SUB